home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_menus < prev    next >
Encoding:
Text File  |  1991-12-30  |  6.3 KB  |  260 lines
  1. \ Demonstrate the use of the EZMenu Facility for creating
  2. \ and manipulating simple text menus.
  3. \ The first menu illustrates simple action items.
  4. \ The second menu uses a sound processing metaphor
  5. \ to illustrate the use of attribute menus.
  6. \ Please see the source file "amiga_menus" to help
  7. \ understand how EZMenu works.
  8. \
  9. \ Author: Phil Burk
  10. \ Copyright 1986 Delta Research
  11. \
  12. \ MOD: PLB 9/13/90 Added "Noise" sub-menu example.
  13. \ MOD: PLB 6/6/91 Adapt to new textra submenu code.
  14. \ 00001 PLB 12/30/91 Added EV.WAIT for better performance.
  15.  
  16. include? newwindow.setup ju:amiga_graph
  17. include? ev.getclass ju:amiga_events
  18. include? menuitem.setup ju:amiga_menus
  19.  
  20. ANEW TASK-DEMO_MENUS
  21.  
  22. \ Define EZMenu structures.
  23. EZMenu CONTROL-MENU
  24. EZMenu SOUND-MENU
  25. EZMenu SUB-MENU
  26.  
  27. \ Example words to execute for menu picks.
  28. VARIABLE DEMO-QUIT
  29. : HELLO ( -- , something to do )
  30.     ." Hello, and Welcome to JForth!" cr
  31. ;
  32.  
  33. : ENABLE.QUIT ( -- , allow demo to be quit from menu )
  34. \ This exemplifies a word that is required before another
  35. \ can be executed. For example, sometimes you must LOAD before
  36. \ You can SAVE.
  37.     gr-curwindow @
  38.     0 2 0 menu.mis>#  ( calculate menunum )
  39.     OnMenu()
  40. ;
  41.  
  42. : IQUIT  ( trigger termination of demo )
  43.     true demo-quit !
  44. ;
  45.  
  46. : (CONTROL-MENU.INIT)   ( -- , Setup the structures for control menu. )
  47. \ optionally change default layout
  48.     180 menuitem-defwidth !  ( use different width then default )
  49.     10 menuitem-defleft !
  50. \
  51. \ Set links and other defaults in menu and items.
  52.     0" Control" 0 control-menu ezmenu.setup
  53. \
  54. \ Define text and actions.
  55.     0" Hello" 0 control-menu ezmenu.text!
  56.     ' hello   0 control-menu ezmenu.cfa[] !
  57.     ascii H   0 control-menu ezmenu.commseq!  ( set 'H' command key )
  58. \
  59.     0" Enable Quit" 1 control-menu ezmenu.text!
  60.     ' enable.quit   1 control-menu ezmenu.cfa[] !
  61.     0" Quit"    2 control-menu ezmenu.text!
  62.     ' iquit      2 control-menu ezmenu.cfa[] !
  63. \
  64. \ Demonstrate advanced technique not supported by EZMenu.
  65. \ Start off with QUIT initially disabled.
  66.     ITEMTEXT HIGHCOMP | ( ITEMENABLED | left out of flags )
  67.     2 control-menu ezmenu.item[]  ( get relative address of item )
  68.     s! mi_flags
  69. ;
  70.  
  71. : CONTROL-MENU.INIT   ( -- ok , Setup the structures for control menu. )
  72.     3 control-menu ezmenu.alloc? dup  ( allocate space for 4 text menuitems )
  73.     IF
  74.         (control-menu.init)
  75.     ELSE
  76.         ." Could not allocate CONTROL-MENU!" cr
  77.     THEN
  78. ;
  79.  
  80. : SOUND.REPORT ( -- , report menu pick, demonstrate getting item# )
  81.     ezmenu-lastitem @ ." Sound Item = " . cr
  82. ;
  83.  
  84. : NOISE.REPORT ( -- , action for noise reduction pick )
  85.     ezmenu-lastsubitem @
  86.     ." Noise reduction type " . cr
  87. ;
  88.  
  89. : (SOUND-MENU.INIT)  ( -- , Setup sound menu. )
  90.     0" Sound" 1 sound-menu ezmenu.setup
  91. \
  92. \ Define text for second menu.
  93.     0" Clean Sound" 0 sound-menu ezmenu.text!
  94.     0" Reverb"      1 sound-menu ezmenu.text!
  95.     0" Fuzz"        2 sound-menu ezmenu.text!
  96.     0" Flanger"     3 sound-menu ezmenu.text!
  97. \ disable "----" item
  98.     ITEMTEXT HIGHCOMP | ( ITEMENABLED | left out of flags )
  99.         4 sound-menu ezmenu.item[] s! mi_flags
  100.     0" Noise Reduction"     5 sound-menu ezmenu.text!
  101. \
  102. \ Use same action for all items. (OK, I'm lazy!)
  103.     5 0 DO
  104.         ' sound.report i sound-menu ezmenu.cfa[] !
  105.     LOOP
  106.     ' noise.report 5 sound-menu ezmenu.cfa[] !
  107. \
  108. \ Set mutual exclusion for groups.
  109.     $ 0E 0 sound-menu ezmenu.exclude!
  110.     $ 01 1 sound-menu ezmenu.exclude!
  111.     $ 01 2 sound-menu ezmenu.exclude!
  112.     $ 01 3 sound-menu ezmenu.exclude!
  113. \
  114. \ Set checkmarks for default items.
  115.     CHECKED 0 sound-menu ezmenu.set.flag
  116. ;
  117.  
  118. : SOUND-MENU.INIT  ( -- ok , Setup sound menu. )
  119.     6 sound-menu ezmenu.alloc? dup
  120.     IF
  121.         (sound-menu.init)
  122.     ELSE
  123.         ." Could not allocate SOUND-MENU!" cr
  124.     THEN
  125. ;
  126.  
  127. : DOLBY.B  ." Dolby B Noise Reduction" cr ;
  128. : DOLBY.C  ." Dolby C Noise Reduction" cr ;
  129. : DBX  ." DBX Noise Reduction" cr ;
  130.  
  131. : SUB-MENU.INIT  ( -- ok , Setup submenu for "noise reduction". )
  132.     100 menuitem-defleft !
  133.     140 menuitem-defwidth !
  134.     3 sub-menu ezmenu.alloc? dup
  135.     IF
  136.         sub-menu ezsubmenu.setup
  137. \
  138. \ Define text for second menu.
  139.         0" Dolby B" ' dolby.b  ascii B 0 sub-menu ezmenu.setitem
  140.         0" Dolby C" ' dolby.c  ascii C 1 sub-menu ezmenu.setitem
  141.         0" dbx"     ' dbx      ascii X 2 sub-menu ezmenu.setitem
  142. \
  143. \ Set mutual exclusion for groups.
  144.         $ 06 0 sub-menu ezmenu.exclude!
  145.         $ 05 1 sub-menu ezmenu.exclude!
  146.         $ 03 2 sub-menu ezmenu.exclude!
  147. \
  148. \ Set checkmarks for default items.
  149.         CHECKED 0 sub-menu ezmenu.set.flag
  150.     ELSE
  151.         ." Could not allocate SUB-MENU!" cr
  152.     THEN
  153. ;
  154.  
  155. : MYMENUS.TERM  ( -- , free memory used )
  156.     control-menu ezmenu.free
  157.     sound-menu ezmenu.free
  158.     sub-menu ezmenu.free
  159. ;
  160.  
  161. : MYMENUS.INIT   ( -- ok , Initialize both menus. )
  162.     false \ default return flag
  163.     control-menu.init
  164.     IF
  165.         sound-menu.init
  166.         IF
  167.             sub-menu.init
  168.             IF
  169.                 control-menu sound-menu menu.linkto
  170.                 sub-menu 5 sound-menu ezmenu.submenu!
  171.                 drop true
  172.             ELSE
  173.                 mymenus.term
  174.             THEN
  175.         ELSE
  176.             mymenus.term
  177.         THEN
  178.     THEN
  179.  
  180. \ Since CONTROL-MENU is now the first menu, it is used as the "MENUSTRIP"
  181. \ for calls to SetMenuStrip, EZMENU.EXEC, etc.
  182. ;
  183.  
  184. : PROCESS.EVENT ( class -- done? , process events from IDCMP )
  185.     CASE
  186.         MENUPICK   ( execute appropriate word for item )
  187.         OF  ev-last-code @  control-menu  ezmenu.exec
  188.             false
  189.         ENDOF
  190. \
  191.         CLOSEWINDOW OF true ENDOF
  192. \
  193.         ( other events ) false swap
  194.     ENDCASE
  195. ;
  196.  
  197. : MENU.LOOP  ( -- , loop until done )
  198.     false demo-quit !
  199.     BEGIN
  200.         gr-curwindow @ ev.wait \ 00001
  201.         gr-curwindow @ ev.getclass dup
  202.         IF process.event
  203.         THEN
  204.         demo-quit @ OR
  205.     UNTIL
  206. ;
  207.  
  208. NewWindow MenuWindow   ( Create a template for the new window. )
  209.  
  210. : MENUS.INIT  ( -- ok? , Initialize Demo )
  211.     cr gr.init
  212.     ." AMIGA JForth Pulldown Menu Demonstration" cr
  213.     MenuWindow NewWindow.Setup      ( Set defaults for window )
  214.     0" JForth - Test Menus!"  MenuWindow s! nw_title
  215.     400 MenuWindow s! nw_width
  216.     100 MenuWindow s! nw_height
  217. \
  218. \ Add MENUPICK and ACTIVATE flags to window.
  219.     CLOSEWINDOW MOUSEBUTTONS | MENUPICK |
  220.     MenuWindow s! nw_idcmpflags
  221.     MenuWindow s@ nw_flags  ACTIVATE |
  222.     MenuWindow s! nw_flags
  223. \
  224. \ Create window from template and make it the current window.
  225.     MenuWindow gr.opencurw
  226.     IF
  227. \ Setup Menus and link to window.
  228.         mymenus.init
  229.         IF
  230.             gr-curwindow @ control-menu SetMenuStrip() true
  231.         ELSE
  232.             false
  233.         THEN
  234.     ELSE
  235.         false
  236.     THEN
  237. ;
  238.  
  239. : MENUS.TERM  ( -- , cleanup )
  240.     gr-curwindow @ ?dup
  241.     IF
  242.         ClearMenuStrip()
  243.         gr.closecurw
  244.         mymenus.term
  245.     THEN
  246.     gr.term
  247. ;
  248.  
  249. : MENUS ( -- , Demonstrate pulldown menus. )
  250.     menus.init
  251.     IF
  252.         menu.loop
  253.         menus.term
  254.     THEN
  255. ;
  256.  
  257. if.forgotten menus.term
  258.  
  259. cr ." Enter:   MENUS     for demo!" cr
  260.